home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / Macros / Editing Macros < prev    next >
Text File  |  1996-05-22  |  7KB  |  297 lines
  1. var {Global variable, initially zero}
  2.   RoiLeft,RoiTop,RoiRight,RoiBottom:integer;
  3.  
  4. macro 'Show Tools [T]';
  5. begin
  6.   SelectWindow('Tools');
  7. end;
  8.  
  9. Macro 'Draw Arrow [A]'
  10. {Draws an arrow based on the current straight line selection.}
  11. var
  12.   size,angle,dx,dy,pi,theta:real;
  13.   x1,y1,x2,y2,LineWidth,width,height:integer;
  14. begin
  15.   size:=12;  {pixels}
  16.   angle:=20; {degrees}
  17.   pi:=3.14159;
  18.   GetLine(x1,y1,x2,y2,LineWidth);
  19.   if x1<0 then begin
  20.      beep;
  21.     PutMessage('Use the line tool (straight) to select a line first.');
  22.     exit;
  23.   end;
  24.   MoveTo(x1,y1);
  25.   LineTo(x2,y2);
  26.   KillRoi;
  27.   GetPicSize(width,height);
  28.   y1:=height-y1;
  29.   y2:=height-y2;
  30.   if LineWidth>1 then size:=size*LineWidth*0.5;
  31.   angle:=(angle/180)*pi;
  32.   dx:=x1-x2;
  33.   dy:=y1-y2;
  34.   if dx=0 then begin
  35.     if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  36.   end else begin
  37.     theta:=arctan(dy/dx);
  38.     if dx<0 then theta:=theta+pi;
  39.   end;
  40.   moveto(x2,height-y2);
  41.   lineto(x2+size*cos(theta+angle),height-(y2+size*sin(theta+angle)));
  42.   moveto(x2,height-y2);
  43.   lineto(x2+size*cos(theta-angle),height-(y2+size*sin(theta-angle)));
  44. end;
  45.  
  46. macro 'Clear Outside [C]'
  47.  {Erase region outside current selection to background color.}
  48. begin
  49.   Copy;
  50.   SelectAll;
  51.   Clear;
  52.   RestoreRoi;
  53.   Paste;
  54.   KillRoi;
  55. end;
  56.  
  57. macro 'Change Colors';
  58. {
  59. Changes the value of pixels in the image that are in
  60. the current foreground color to the current background
  61. color. Use Undo if you don't like the result.
  62. }
  63. var
  64.   SavePixel,foreground,background:integer;
  65.  begin
  66.   SavePixel:=GetPixel(0,0);
  67.   MakeRoi(0,0,1,1);
  68.   Fill;
  69.   foreground:=GetPixel(0,0);
  70.   Clear;
  71.   background:=GetPixel(0,0);
  72.   PutPixel(0,0,SavePixel);
  73.   PutMessage('Pixels in the foreground color (',foreground:1,') will be changed to the background color (',background:1,').');
  74.   ChangeValues(foreground,foreground,background);
  75. end;
  76.  
  77. macro 'Change Values…';
  78. var
  79.   v1,v2:integer;
  80. begin
  81.   v1:=GetNumber('Change pixels with this value:',255);
  82.   v2:=GetNumber('to this value:',254);
  83.   ChangeValues(v1,v1,v2);
  84. end;
  85.  
  86. macro 'Fix Pseudocolors';
  87. begin
  88.   ChangeValues(0,0,1);
  89.   ChangeValues(255,255,254);
  90. end;
  91.  
  92. macro 'Remove Isolated Black Lines';
  93. var
  94.   width,height,value,x,y,xstart,ystart:integer;
  95. begin
  96.   GetRoi(xstart,ystart,width,height);
  97.   if width=0 then begin
  98.     PutMessage('This macro requires a retangular selection');
  99.     exit;
  100.   end;
  101.   for y:=ystart to ystart+height-1 do begin
  102.     if GetPixel(width div 2,y)=255 then
  103.       for x:=xstart to xstart+width-1 do
  104.         PutPixel(x,y,(GetPixel(x,y-1)+GetPixel(x,y+1))/2);
  105.   end;
  106.   KillRoi;
  107. end;
  108.  
  109. macro 'Make Mosaic';
  110. var
  111.   n:integer;
  112. begin
  113.   SaveState;
  114.   n:=GetNumber('Cell Size(pixels square):',8);
  115.   Duplicate('Mosaic');
  116.   SetScaling('Nearest; Same Window');
  117.   ScaleSelection(1/n,1/n);
  118.   RestoreRoi;
  119.   ScaleSelection(n,n);
  120.   RestoreState;
  121. end;
  122.  
  123. macro 'Draw Grid...';
  124. var
  125.   x, y, xinc, yinc, width, height:integer;
  126.   scale, x, y, xinc, yinc: real;
  127.   unit, prompt: string;
  128. begin
  129.   GetPicSize(width, height);
  130.   GetScale(scale, unit);
  131.   prompt := concat('Spacing (', unit, '):');
  132.   xinc := GetNumber(prompt, 10) * scale;
  133.   yinc := xinc;
  134.   x := 0;
  135.   y := 0;
  136.   repeat
  137.      x := x + xinc;
  138.      y := y + yinc;
  139.      moveto(0, round(y));
  140.      lineto(width, round(y));
  141.      moveto(round(x), 0);
  142.      lineto(round(x), height);
  143.   until (x > width) and (y > height);
  144. end;
  145.  
  146. macro 'Make 256x256 Selection [S]';
  147. {Creates a 256x256 selection centered on the image.}
  148. var
  149.   w,h:integer;
  150. begin
  151.   GetPicSize(w,h);
  152.   MakeRoi((w-246)/2,(h-256)/2, 256, 256);
  153. end;
  154.  
  155.  
  156. macro 'Position fixed size ROI';
  157. var width,height,x,y:integer;
  158. begin
  159.   width:=100; height:=100;
  160.   repeat
  161.      GetMouse(x,y);
  162.      MakeRoi(x-width/2,y-height/2,width,height);
  163.      DrawBoundary;
  164.      Undo;
  165.   until button;
  166. end;
  167.  
  168. macro 'Flip ROI Horizontally';
  169. {
  170. Creates a "mirror image" of the current ROI.  It opens a temporary
  171. blank window, transfers the ROI to that window, draws its outline,
  172. flips the contents horizontally, creates a new marching ants ROI 
  173. using the AutoOutline command, restores the flipped ROI to the
  174. original window, and then deletes the temporary window.
  175. }
  176. var
  177.   hloc,vloc,width,height,pid1,pid2:integer;
  178. begin
  179.   RequiresVersion(1.55);
  180.   GetRoi(hloc,vloc,width,height);
  181.   if width=0 then begin
  182.     PutMessage('This macro requires a selection');
  183.     exit;
  184.   end;
  185.   SaveState;
  186.   MoveRoi(-hloc,-vloc);
  187.   KillRoi;
  188.   SetNewSize(width+1,height);
  189.   SetForegroundColor(255);
  190.   SetBackgroundColor(0);
  191.   pid1:=PidNumber;
  192.   MakeNewWindow('Temp');
  193.   RestoreRoi;
  194.   DrawBoundary;
  195.   SelectAll;
  196.   FlipHorizontal;
  197.   KillRoi;
  198.   AutoOutline(0,height/2);
  199.   pid2:=PidNumber;
  200.   SelectPic(pid1);
  201.   RestoreRoi;
  202.   SelectPic(pid2);
  203.   Dispose;
  204.   RestoreState;
  205. end;
  206.  
  207.  
  208. macro '(-' begin end;
  209.  
  210. macro 'Make Circle… [M]';
  211. var
  212.   x1,x2,y1,y2,top,left,width,height: integer;
  213.   xcenter, ycenter: integer;
  214.   d, scale, default: real;
  215.   unit, prompt: string;
  216. begin
  217.   GetLine(x1,y1,x2,y2,width);
  218.   if x1<0 then begin
  219.     PutMessage('Click with line selection tool to define center.');
  220.     exit;
  221.   end;
  222.   xcenter:=x1+(x2-x1)/2;
  223.   ycenter:=y1+(y2-y1)/2;
  224.   GetScale(scale, unit);
  225.   if unit='pixel' then unit:='pixels';
  226.   default:=50/scale;
  227.   prompt:=concat('Diameter (', unit:1:2, '):');
  228.   d:=GetNumber(prompt, default);
  229.   d:=d*scale;
  230.   MakeOvalROI(xcenter-d/2, ycenter-d/2, d, d);
  231. end;
  232.  
  233.  
  234. macro 'Make Circle from Line';
  235. var
  236.   x1,x2,y1,y2,top,left,width,height:integer;
  237.   xcenter,ycenter,radius:integer;
  238. begin
  239.   GetLine(x1,y1,x2,y2,width);
  240.   if x1<0 then begin
  241.     PutMessage('This macro requires a line selection.');
  242.     exit;
  243.   end;
  244.   xcenter:=x1+(x2-x1)/2;
  245.   ycenter:=y1+(y2-y1)/2;
  246.   radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  247.   MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2);
  248. end;
  249.  
  250.  
  251. macro 'Define Upper Left [1]';
  252. var
  253.   x1,y1,x2,y2,LineWidth:integer;
  254. begin
  255.   GetLine(x1,y1,x2,y2,LineWidth);
  256.   if x1<0 then begin
  257.      PutMessage('Click with line selection tool to define upper left corner of ROI.');
  258.      exit;
  259.   end;
  260.   RoiLeft:=x1+(x2-x1)/2;
  261.   RoiTop:=y1+(y2-y1)/2;
  262. end;
  263.  
  264. macro 'Define Lower Right and Create ROI [2]';
  265. var
  266.   x1,y1,x2,y2,LineWidth:integer;
  267. begin
  268.   GetLine(x1,y1,x2,y2,LineWidth);
  269.   if x1<0 then begin
  270.      PutMessage('Click with line selection tool to define lower right corner of ROI.');
  271.      exit;
  272.   end;
  273.   RoiRight:=x1+(x2-x1)/2;
  274.   RoiBottom:=y1+(y2-y1)/2;
  275.   if (RoiLeft=RoiRight) and (RoiTop=RoiBottom) then begin
  276.     PutMessage('Upper left and bottom right are the same.');
  277.     exit;
  278.   end;
  279.   MakeRoi(RoiLeft,RoiTop,RoiRight-RoiLeft,RoiBottom-RoiTop)
  280. end;
  281.  
  282.  
  283. macro 'Draw File Name in each Image';
  284.  var
  285.    i: integer;
  286. begin
  287.   SaveState;
  288.   SetForegroundColor(255);
  289.   for i := 1 to nPics do begin
  290.      SelectPic(i);
  291.      MoveTo(10,12);
  292.      Write(WindowTitle);
  293.   end;
  294.   RestoreState;
  295. end;
  296.  
  297.